home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / AmigaE / Src / Rkrm / Graphics_Libraries / Primitives / WBClone.e < prev   
Encoding:
Text File  |  1995-09-20  |  9.3 KB  |  295 lines
  1. -> WBClone.e - Clone the Workbench using graphics calls
  2.  
  3. ->>> Header (globals)
  4. OPT PREPROCESS
  5.  
  6. MODULE 'exec/memory',
  7.        'graphics/displayinfo',
  8.        'graphics/gfx',
  9.        'graphics/gfxnodes',
  10.        'graphics/monitor',
  11.        'graphics/rastport',
  12.        'graphics/view',
  13.        'graphics/videocontrol',
  14.        'intuition/intuitionbase',
  15.        'intuition/screens'
  16.  
  17. ENUM ERR_NONE, ERR_CMAP, ERR_DINFO, ERR_GFXNEW, ERR_KICK, ERR_MONI
  18.  
  19. RAISE ERR_CMAP   IF GetColorMap()=NIL,
  20.       ERR_DINFO  IF GetDisplayInfoData()=NIL,
  21.       ERR_GFXNEW IF GfxNew()=NIL,
  22.       ERR_KICK   IF KickVersion()=FALSE,
  23.       ERR_MONI   IF OpenMonitor()=NIL
  24.  
  25. #define INTUITIONNAME 'intuition.library'
  26. ->>>
  27.  
  28. ->>> PROC destroyView(view:PTR TO view)
  29. -> Close and free everything to do with the View
  30. PROC destroyView(view:PTR TO view)
  31.   DEF ve:PTR TO viewextra
  32.   IF view
  33.     IF ve:=GfxLookUp(view)
  34.       IF ve.monitor THEN CloseMonitor(ve.monitor)
  35.       GfxFree(ve)
  36.     ENDIF
  37.  
  38.     -> Free up the copper lists
  39.     IF view.lofcprlist THEN FreeCprList(view.lofcprlist)
  40.     IF view.shfcprlist THEN FreeCprList(view.shfcprlist)
  41.  
  42.     Dispose(view)
  43.   ENDIF
  44. ENDPROC
  45. ->>>
  46.  
  47. ->>> PROC dupView(v:PTR TO view, modeID)
  48. -> Duplicate the View
  49. PROC dupView(v:PTR TO view, modeID) HANDLE
  50.   -> Allocate and init a view OBJECT.  Also, get a viewextra OBJECT and
  51.   -> attach the monitor type to the View.
  52.   DEF view=NIL:PTR TO view, ve=NIL:PTR TO viewextra,
  53.       mspc=NIL:PTR TO monitorspec
  54.   view:=NewM(SIZEOF view, MEMF_CLEAR OR MEMF_PUBLIC)
  55.   ve:=GfxNew(VIEW_EXTRA_TYPE)
  56.   mspc:=OpenMonitor(NIL, modeID)
  57.   InitView(view)
  58.   view.dyoffset:=v.dyoffset
  59.   view.dxoffset:=v.dxoffset
  60.   view.modes:=v.modes
  61.   GfxAssociate(view, ve)
  62.   ve.monitor:=mspc
  63.   RETURN view
  64. EXCEPT
  65.   -> E-Note: C version is wrong; failure may happen before attaching to view
  66.   IF mspc THEN CloseMonitor(mspc)
  67.   IF ve THEN GfxFree(ve)
  68.   IF view THEN Dispose(view)
  69.   ReThrow()  -> E-Note: pass on exception if it was an error
  70. ENDPROC
  71. ->>>
  72.  
  73. ->>> PROC destroyViewPort(vp:PTR TO viewport)
  74. -> Close and free everything to do with the viewport
  75. PROC destroyViewPort(vp:PTR TO viewport)
  76.   DEF cm:PTR TO colormap, ti:PTR TO LONG
  77.   IF vp
  78.     -> Find the ViewPort's ColorMap.  From that use VideoControl to get the
  79.     -> ViewPortExtra, and free it.
  80.     -> Then free the ColorMap, and finally the ViewPort itself.
  81.     IF cm:=vp.colormap
  82.       -> E-Note: ti[1] will be filled in by the call to VideoControl
  83.       IF VideoControl(cm, ti:=[VTAG_VIEWPORTEXTRA_GET, NIL, NIL])=NIL
  84.         GfxFree(ti[1])
  85.       ELSE
  86.         WriteF('VideoControl error in destroyViewPort()\n')
  87.       ENDIF
  88.  
  89.       FreeColorMap(cm)
  90.     ELSE
  91.       WriteF('Could not free the ColorMap\n')
  92.     ENDIF
  93.  
  94.     FreeVPortCopLists(vp)
  95.  
  96.     Dispose(vp)
  97.   ENDIF
  98. ENDPROC
  99. ->>>
  100.  
  101. ->>> PROC dupViewPort(vp:PTR TO viewport, modeID)
  102. CONST COLOURS=32  -> E-Note: this is a bit out of date...
  103.  
  104. -> Duplicate the ViewPort
  105. PROC dupViewPort(vp:PTR TO viewport, modeID) HANDLE
  106.   -> Allocate and initialise a ViewPort.  Copy the ViewPort width and heights,
  107.   -> offsets, and modes values.  Allocate and initialise a ColorMap.
  108.   ->
  109.   -> Also, allocate a ViewPortExtra, and copy the TextOScan values of the
  110.   -> ModeID from the database into the ViewPortExtra.
  111.   DEF myvp=NIL:PTR TO viewport, vpe=NIL:PTR TO viewportextra,
  112.       cm=NIL:PTR TO colormap, query:dimensioninfo, colour, c
  113.   myvp:=NewM(SIZEOF viewport, MEMF_CLEAR OR MEMF_PUBLIC)
  114.   vpe:=GfxNew(VIEWPORT_EXTRA_TYPE)
  115.   cm:=GetColorMap(COLOURS)  -> E-Note: use the constant that's been defined!
  116.   GetDisplayInfoData(NIL, query, SIZEOF dimensioninfo, DTAG_DIMS, modeID)
  117.   InitVPort(myvp)
  118.  
  119.   -> Duplicate the viewport object
  120.   myvp.dwidth:=vp.dwidth
  121.   myvp.dheight:=vp.dheight
  122.   myvp.dxoffset:=vp.dxoffset
  123.   myvp.dyoffset:=vp.dyoffset
  124.   myvp.modes:=vp.modes
  125.   myvp.spritepriorities:=vp.spritepriorities
  126.   myvp.extendedmodes:=vp.extendedmodes
  127.  
  128.   -> Duplicate the Overscan values
  129.   CopyMem(query.txtoscan, vpe.displayclip, SIZEOF rectangle)
  130.  
  131.   -> Attach everything together
  132.   IF VideoControl(cm, [VTAG_ATTACH_CM_SET, myvp,
  133.                        VTAG_VIEWPORTEXTRA_SET, vpe,
  134.                        VTAG_NORMAL_DISP_SET, FindDisplayInfo(modeID),
  135.                        NIL])
  136.     WriteF('VideoControl error in duplicateViewPort()\n')
  137.   ENDIF
  138.  
  139.   -> Copy the colours from the Workbench
  140.   FOR c:=0 TO COLOURS-1
  141.     IF -1<>(colour:=GetRGB4(vp.colormap, c))
  142.       SetRGB4CM(cm, c, Shr(colour, 8), Shr(colour, 4) AND $F, colour AND $F)
  143.     ENDIF 
  144.   ENDFOR
  145.   RETURN myvp
  146. EXCEPT
  147.   -> E-Note: C version is wrong; failure may happen before attaching to myvp
  148.   IF cm THEN FreeColorMap(cm)
  149.   IF vpe THEN GfxFree(vpe)
  150.   IF myvp THEN Dispose(myvp)
  151.   ReThrow()  -> E-Note: pass on exception if an error
  152. ENDPROC
  153. ->>>
  154.  
  155. ->>> PROC destroyBitMap(mybm:PTR TO bitmap, width, height, depth)
  156. -> Close and free everything to do with the BitMap
  157. PROC destroyBitMap(mybm:PTR TO bitmap, width, height, depth)
  158.   DEF i
  159.   IF mybm
  160.     FOR i:=0 TO depth-1
  161.       IF mybm.planes[i] THEN FreeRaster(mybm.planes[i], width, height)
  162.     ENDFOR
  163.     Dispose(mybm)
  164.   ENDIF
  165. ENDPROC
  166. ->>>
  167.  
  168. ->>> PROC createBitMap(width, height, depth)
  169. -> Create the BitMap
  170. PROC createBitMap(width, height, depth) HANDLE
  171.   -> Allocate a bitmap OBJECT, initialise it and allocate each plane.
  172.   DEF mybm:PTR TO bitmap, i
  173.   mybm:=NewM(SIZEOF bitmap, MEMF_CLEAR OR MEMF_PUBLIC)
  174.   InitBitMap(mybm, depth, width, height)
  175.   FOR i:=0 TO depth-1
  176.     mybm.planes[i]:=AllocRaster(width, height)
  177.   ENDFOR
  178.   RETURN mybm
  179. EXCEPT
  180.   -> E-Note: hey! the C version is OK this time!
  181.   destroyBitMap(mybm, width, height, depth)
  182.   ReThrow()  -> E-Note: pass on exception if an error
  183. ENDPROC
  184. ->>>
  185.  
  186. ->>> PROC showView(view, vp, bm, width, height)
  187. -> Assemble and display the View
  188. PROC showView(view:PTR TO view, vp:PTR TO viewport, bm:PTR TO bitmap,
  189.               width, height) HANDLE
  190.   -> Attach the BitMap to the ViewPort via a RasInfo.  Attach the ViewPort to
  191.   -> the View.  Clear the BitMap, and draw into it by attaching the BitMap to
  192.   -> a RastPort.  Then MakeVPort(), MrgCop() and LoadView().
  193.   -> Just wait for the user to press <RETURN> before returning.
  194.   DEF rp=NIL:PTR TO rastport, ri=NIL:PTR TO rasinfo
  195.   rp:=NewM(SIZEOF rastport, MEMF_CLEAR OR MEMF_PUBLIC)
  196.   ri:=NewM(SIZEOF rasinfo, MEMF_CLEAR OR MEMF_PUBLIC)
  197.   InitRastPort(rp)
  198.   rp.bitmap:=bm
  199.   ri.bitmap:=bm
  200.   vp.rasinfo:=ri
  201.   view.viewport:=vp
  202.  
  203.   -> Render
  204.   SetRast(rp, 0)  -> Clear the background
  205.   SetAPen(rp, Shl(1, bm.depth)-1)  -> Use the last pen
  206.   Move(rp, 0, 0)
  207.   Draw(rp, width, 0)
  208.   Draw(rp, width, height)
  209.   Draw(rp, 0, height)
  210.   Draw(rp, 0, 0)
  211.  
  212.   -> Display it
  213.   MakeVPort(view, vp)
  214.   MrgCop(view)
  215.   LoadView(view)
  216.  
  217.   -> E-Note: make this work even under Workbench
  218.   WriteF('');  Inp(IF stdin THEN stdin ELSE stdout)
  219.  
  220.   -> Bring back the system
  221.   RethinkDisplay()
  222. EXCEPT DO
  223.   IF ri THEN Dispose(ri)
  224.   IF rp THEN Dispose(rp)
  225.   ReThrow()  -> E-Note: pass on exception if an error
  226. ENDPROC
  227. ->>>
  228.  
  229. ->>> PROC main()
  230. -> Clone the Workbench View using Graphics Library calls.
  231. PROC main() HANDLE
  232.   DEF wb=NIL:PTR TO screen, myview=NIL, myvp=NIL, mybm=NIL,
  233.       modeID, ibaseLock=NIL, intuition:PTR TO intuitionbase
  234.  
  235.   KickVersion(37)  -> E-Note: requires V37
  236.  
  237.   -> To clone the Workbench using graphics calls involves duplicating the
  238.   -> Workbench ViewPort, ViewPort mode, and Intuition's View.  This also
  239.   -> involves duplicating the DisplayClip for the overscan value, the colours,
  240.   -> and the View position.
  241.   ->
  242.   -> When this is all done, the View, ViewPort, ColorMap and BitMap (and
  243.   -> ViewPortExtra, ViewExtra and RasInfo) all have to be linked together, and
  244.   -> the copperlists made to create the display.
  245.   ->
  246.   -> This is not as difficult as it sounds (trust me!)
  247.  
  248.   -> First, lock the Workbench screen, so no changes can be made to it while
  249.   -> we are duplicating it.
  250.   wb:=LockPubScreen('Workbench')
  251.  
  252.   -> Find the Workbench's ModeID.  This is a 32-bit number that identifies the
  253.   -> monitor type, and the display mode of that monitor.
  254.   modeID:=GetVPModeID(wb.viewport)
  255.  
  256.   -> We need to duplicate Intuition's View structure, so lock IntuitionBase to
  257.   -> prevent the View changing under our feet.
  258.   ibaseLock:=LockIBase(0)
  259.   intuition:=intuitionbase  -> E-Note: get the right type for intuitionbase
  260.   myview:=dupView(intuition.viewlord, modeID)
  261.  
  262.   -> The View has been cloned, so we don't need to keep it locked.
  263.   UnlockIBase(ibaseLock)
  264.   ibaseLock:=NIL  -> E-Note: set to NIL so we don't Unlock it again
  265.  
  266.   -> Now duplicate the Workbench's ViewPort.  Remember, we still have the
  267.   -> Workbench locked.
  268.   myvp:=dupViewPort(wb.viewport, modeID)
  269.  
  270.   -> Create a BitMap to render into.  This will be of the same dimensions
  271.   -> as the Workbench.
  272.   mybm:=createBitMap(wb.width, wb.height, wb.bitmap.depth)
  273.  
  274.   -> Now we have everything copied, show something
  275.   showView(myview, myvp, mybm, wb.width-1, wb.height-1)
  276.  
  277. EXCEPT DO
  278.   -> Free up everything we may have allocated or still have locked
  279.   IF mybm THEN destroyBitMap(mybm, wb.width, wb.height, wb.bitmap.depth)
  280.   IF myvp THEN destroyViewPort(myvp)
  281.   IF myview THEN destroyView(myview)
  282.   IF ibaseLock THEN UnlockIBase(ibaseLock)
  283.   IF wb THEN UnlockPubScreen(NIL, wb)
  284.   SELECT exception
  285.   CASE ERR_CMAP;    WriteF('Could not get ColorMap\n')
  286.   CASE ERR_DINFO;   WriteF('Display database error\n')
  287.   CASE ERR_GFXNEW;  WriteF('Could not get the View-/ViewPort- Extra\n')
  288.   CASE ERR_KICK;    WriteF('Requires at least V37\n')
  289.   CASE ERR_MONI;    WriteF('Could not open monitor\n')
  290.   CASE "MEM";       WriteF('Ran out of memory\n')
  291.   ENDSELECT
  292. ENDPROC
  293. ->>>
  294.  
  295.